home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / AUTODRAW / AUTODRAW.ZIP / MLBMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-23  |  11.3 KB  |  413 lines
  1. unit MLBMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Grids, ComCtrls, ExtCtrls, StdCtrls, Menus, adGrids, MLBData;
  8.  
  9. type
  10.  
  11.   TFormMain = class(TForm)
  12.     adDrawGrid1: TadDrawGrid;
  13.     Ascending1: TMenuItem;
  14.     CheckBoxColor: TCheckBox;
  15.     CheckBoxEllipsis: TCheckBox;
  16.     CheckBoxExpand: TCheckBox;
  17.     CheckBoxFont: TCheckBox;
  18.     CheckBoxHighlight: TCheckBox;
  19.     ComboBoxAlignment: TComboBox;
  20.     Descending1: TMenuItem;
  21.     ImageList1: TImageList;
  22.     LabelAlignment: TLabel;
  23.     PanelProperty: TPanel;
  24.     PanelSplitter: TPanel;
  25.     PopupMenu1: TPopupMenu;
  26.     RichEdit: TRichEdit;
  27.     TabDemo: TTabControl;
  28.     TabDivisions: TTabControl;
  29.     procedure adDrawGrid1DrawBitmap(Sender: TObject; ACol, ARow: Longint;
  30.       State: TGridDrawState; var ImageIndex: Integer;
  31.       var Alignment: TadCellAlignment; var Margin: Integer);
  32.     procedure adDrawGrid1DrawText(Sender: TObject; ACol, ARow: Longint;
  33.       State: TGridDrawState; var Font: TFont; var Color: TColor;
  34.       var Align: TadCellAlignment; var Margin: Integer);
  35.     procedure adDrawGrid1GetText(Sender: TObject; ACol, ARow: Longint;
  36.       var Value: string);
  37.     procedure adDrawGrid1TitleClick(Sender: TObject; Button: TMouseButton;
  38.       Shift: TShiftState; ACol: Longint);
  39.     procedure Ascending1Click(Sender: TObject);
  40.     procedure Descending1Click(Sender: TObject);
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure CheckBoxColorClick(Sender: TObject);
  43.     procedure CheckBoxColorEnter(Sender: TObject);
  44.     procedure CheckBoxEllipsisClick(Sender: TObject);
  45.     procedure CheckBoxEllipsisEnter(Sender: TObject);
  46.     procedure CheckBoxFontClick(Sender: TObject);
  47.     procedure CheckBoxFontEnter(Sender: TObject);
  48.     procedure CheckBoxHighlightClick(Sender: TObject);
  49.     procedure CheckBoxHighlightEnter(Sender: TObject);
  50.     procedure ComboBoxAlignmentChange(Sender: TObject);
  51.     procedure ComboBoxAlignmentEnter(Sender: TObject);
  52.     procedure CheckBoxExpandEnter(Sender: TObject);
  53.     procedure CheckBoxExpandClick(Sender: TObject);
  54.     procedure TabDemoChange(Sender: TObject);
  55.     procedure TabDivisionsChange(Sender: TObject);
  56.   private
  57.     { Private declarations }
  58.   public
  59.     procedure InitPopup(Ascending: Boolean);
  60.       procedure ResortColumn(ACol: Integer);
  61.     procedure ShowDemoText(const Name: String);
  62.   end;
  63.  
  64. var
  65.   FormMain: TFormMain;
  66.   SortCol: Integer;
  67.   CurrentDivision: TMLBDivision;
  68.  
  69. implementation
  70.  
  71. {$R *.DFM}
  72.  
  73. {$R STRINGS.RES}
  74.  
  75. {
  76.     Component User's Note: The following adDrawGrid event-handler methods
  77.   demonstrate the way AutoDraw grids allow run-time specification of grid
  78.   attributes. See the appropriate event-handler topics in the help file for
  79.   more details on how to use these events.
  80. }
  81.  
  82. {
  83. adDrawGrid1DrawBitmap is the OnDrawBitmap event-handler for the AutoDraw grid.
  84. }
  85. procedure TFormMain.adDrawGrid1DrawBitmap(Sender: TObject; ACol,
  86.   ARow: Longint; State: TGridDrawState; var ImageIndex: Integer;
  87.   var Alignment: TadCellAlignment; var Margin: Integer);
  88. begin
  89.  
  90.     { Exit if we are on a title row or not in first column }
  91.   if (ARow = -1) or (ACol <> 0) then Exit;
  92.  
  93.     { Draw bitmap in first column. BitmapIndex is hardcoded in MLBData }
  94.     Margin := 0;
  95.     ImageIndex := CurrentDivision.Items[ARow].BitmapIndex;
  96.  
  97. end;
  98.  
  99. {
  100. adDrawGrid1DrawText is the OnDrawText event-handler for the AutoDraw grid.
  101. }
  102. procedure TFormMain.adDrawGrid1DrawText(Sender: TObject; ACol, ARow: Longint;
  103.   State: TGridDrawState; var Font: TFont; var Color: TColor;
  104.   var Align: TadCellAlignment; var Margin: Integer);
  105. begin
  106.  
  107.     { Exit if we are on a title row or not in fifth column }
  108.   if (aRow = -1) or (ACol <> 4) then Exit;
  109.  
  110.     { Display percents < .500 in red }
  111.     if (CurrentDivision[ARow].Percent < 0.5) then Font.Color := clRed;
  112. end;
  113.  
  114. {
  115. adDrawGrid1GetText is the OnDrawText for event-handler the AutoDraw grid.
  116. }
  117. procedure TFormMain.adDrawGrid1GetText(Sender: TObject; ACol, ARow: Longint;
  118.   var Value: string);
  119.  
  120.   { Formats Games Back for grid display }
  121.   function FormatGB(GB: Extended): String;
  122.   begin
  123.       Result := Format('%.1f',[GB]);
  124.     if (Result = '0.0') then Result := '-';
  125.     if Result[3] = '0' then Result := Result[1];
  126.   end;
  127.  
  128.     { Formats Streak for grid display }
  129.   function FormatStreak(Streak: Integer): String;
  130.   begin
  131.       if Streak < 0 then Result := 'Lost' else Result := 'Won';
  132.     Result := Result+' '+IntToStr(Abs(Streak));
  133.   end;
  134.  
  135. begin
  136.  
  137.     { Exit if we are on a title row }
  138.   if (ARow = -1) then Exit;
  139.  
  140.   { Otherwise, provide formatted text for normal rows }
  141.     with CurrentDivision[ARow] do
  142.   begin
  143.         { Set Value to fully formatted string, depending on column }
  144.       case ACol of
  145.     1 : Value := Name;
  146.     2 : Value := IntToStr(Won);
  147.     3 : Value := IntToStr(Lost);
  148.     4 : Value := Format('%.3f',[Percent]);
  149.     5 : Value := FormatGB(GamesBack);
  150.     6 : Value := Format('%.2d',[HomeWon])+'-'+Format('%.2d',[HomeLost]);
  151.     7 : Value := Format('%.2d',[RoadWon])+'-'+Format('%.2d',[RoadLost]);
  152.     8 : Value := FormatStreak(Streak);
  153.       end;
  154.   end;
  155.   
  156. end;
  157.  
  158. {
  159. adDrawGrid1TitleClick is the OnTitleClick event-handler for the AutoDraw grid.
  160. }
  161. procedure TFormMain.adDrawGrid1TitleClick(Sender: TObject;
  162.   Button: TMouseButton; Shift: TShiftState; ACol: Longint);
  163. var
  164.     NewOrder : TMLBSortOrder;
  165. begin
  166.  
  167.     if (Button <> mbLeft) then Exit;
  168.  
  169.   { Resort on newly clicked column }
  170.   if (ACol <> SortCol) then
  171.   begin
  172.       if (ACol = 1) or (ACol = 5) then InitPopup(True) else InitPopup(False);
  173.         adDrawGrid1.Columns[SortCol].Title.Font.Style := [];
  174.   end
  175.   else
  176.   begin
  177.       InitPopup(not Ascending1.Checked);
  178.   end;
  179.   ResortColumn(ACol);
  180.  
  181. end;
  182.  
  183. {
  184.     Programmer's Note: The following methods are used by the demonstration to
  185.   implement the new (Delphi 2.0) TList.Sort method, and the attendant
  186.   user-interface elements. For more details, see the MLBData unit, and the
  187.   Delphi 2.0 help.
  188. }
  189.  
  190. {
  191. Ascending1Click is the event-handler for the OnClick event of the Ascending
  192. popup menu item.
  193. }
  194. procedure TFormMain.Ascending1Click(Sender: TObject);
  195. begin
  196.     { Resort, given new ascending/descending value }
  197.     InitPopup(True);
  198.   ResortColumn(SortCol);
  199. end;
  200.  
  201. {
  202. Descending1Click is the event-handler for the OnClick event of the Descending
  203. popup menu item.
  204. }
  205. procedure TFormMain.Descending1Click(Sender: TObject);
  206. begin
  207.     InitPopup(False);
  208.   ResortColumn(SortCol);
  209. end;
  210.  
  211. {
  212. ResortColumn is an internal method which sort the MLB data using the new Delphi
  213. TList.Sort method.
  214. }
  215. procedure TFormMain.ResortColumn(ACol: Integer);
  216. var
  217.     NewOrder : TMLBSortOrder;
  218. begin
  219.  
  220.     { Determine new sort order }
  221.     case ACol of
  222.   1: NewOrder := soTeam;
  223.   2: NewOrder := soWon;
  224.   3: NewOrder := soLost;
  225.   4: NewOrder := soPercent;
  226.   5: NewOrder := soGamesBack;
  227.   end;
  228.  
  229.   { Resort according to new sort order }
  230.   SortCol := ACol;
  231.   CurrentDivision.Sort(NewOrder,Ascending1.Checked);
  232.  
  233.   { Display sorted column title in bold }
  234.     adDrawGrid1.Columns[ACol].Title.Font.Style := [fsBold];
  235.  
  236.   { Redisplay grid }
  237.   adDrawGrid1.Row := 1;
  238.   adDrawGrid1.Invalidate;
  239.   
  240. end;
  241.  
  242. {
  243. InitPopup toggles the ascending/descending popup menu check.
  244. }
  245. procedure TFormMain.InitPopup(Ascending: Boolean);
  246. begin
  247.     Ascending1.Checked := Ascending;
  248.     Descending1.Checked := not Ascending;
  249. end;
  250.  
  251. {
  252.     Programmer's Note: the following methods implement the demo's user-interface
  253.   elements, including the division selector tab.
  254. }
  255.  
  256. {
  257. FormCreate is the OnCreate event-handler for the form. FormCreate initializes
  258. the user-interface elements.
  259. }
  260. procedure TFormMain.FormCreate(Sender: TObject);
  261. begin
  262.     { Initial sorted column is Games Back ('GB') }
  263.   SortCol := 5;
  264.   { Initialize user-interface elements }
  265.     InitPopup(True);
  266.     TabDivisions.TabIndex := 0;
  267.   TabDemo.TabIndex := 0;
  268.   TabDivisionsChange(Self);
  269.   TabDemoChange(Self);
  270.   ComboBoxAlignment.ItemIndex := 3;
  271. end;
  272.  
  273. {
  274. TabDivisionsChange is the OnChange event-handler for the baseball divisions tab.
  275. TabDivisionsChange synchronizes the CurrentDivision global variable with the
  276. currently selected tab.
  277. }
  278. procedure TFormMain.TabDivisionsChange(Sender: TObject);
  279. var
  280.     NewOrder : TMLBSortOrder;
  281. begin
  282.  
  283.     { Synchronize tab and division }
  284.     case TabDivisions.TabIndex of
  285.   0 : CurrentDivision := ALEast;
  286.   1 : CurrentDivision := ALCentral;
  287.   2 : CurrentDivision := ALWest;
  288.   end;
  289.  
  290.   { Set rows to reflect new division }
  291.     adDrawGrid1.RowCount := CurrentDivision.Count+1;
  292.  
  293.   { Resort }
  294.   ResortColumn(SortCol);
  295.  
  296. end;
  297.  
  298. {
  299.     Component User's Note: The following methods support the user-interface
  300.   elements of the 'Column Properties' panel, which demonstrate run-time
  301.   modification of the AutoDraw grid's properties. Each user-interface element
  302.   has an OnEnter event which displays explanatory text (loaded from the
  303.   application resource table) and an OnChange event which modifies the grid's
  304.   properties. See the appropriate property topics in the help file for more
  305.   details on how to use these events.
  306. }
  307.  
  308. procedure TFormMain.CheckBoxColorClick(Sender: TObject);
  309. begin
  310.     if CheckBoxColor.Checked then
  311.   begin
  312.         adDrawGrid1.Columns[5].Color := clWindow;
  313.     adDrawGrid1.Columns[5].Font.Color := clBlack
  314.   end
  315.   else
  316.   begin
  317.         adDrawGrid1.Columns[5].Color := clTeal;
  318.     adDrawGrid1.Columns[5].Font.Color := clWhite;
  319.   end;
  320. end;
  321.  
  322. procedure TFormMain.CheckBoxColorEnter(Sender: TObject);
  323. begin
  324.   ShowDemoText('demo1b');
  325. end;
  326.  
  327. procedure TFormMain.CheckBoxEllipsisClick(Sender: TObject);
  328. begin
  329.     adDrawGrid1.Columns[1].Ellipsis := CheckBoxEllipsis.Checked;
  330. end;
  331.  
  332. procedure TFormMain.CheckBoxEllipsisEnter(Sender: TObject);
  333. begin
  334.   ShowDemoText('demo1d');
  335. end;
  336.  
  337. procedure TFormMain.CheckBoxExpandClick(Sender: TObject);
  338. begin
  339.   adDrawGrid1.Columns[1].AutoExpand := CheckBoxExpand.Checked;
  340. end;
  341.  
  342. procedure TFormMain.CheckBoxExpandEnter(Sender: TObject);
  343. begin
  344.   ShowDemoText('demo1c');
  345. end;
  346.  
  347. procedure TFormMain.CheckBoxFontClick(Sender: TObject);
  348. begin
  349.     if CheckBoxFont.Checked then
  350.         adDrawGrid1.Font.Color := clBlue else
  351.         adDrawGrid1.Font.Color := clBlack;
  352. end;
  353.  
  354. procedure TFormMain.CheckBoxFontEnter(Sender: TObject);
  355. begin
  356.     ShowDemoText('demo1a');
  357. end;
  358.  
  359. procedure TFormMain.CheckBoxHighlightClick(Sender: TObject);
  360. begin
  361.     if CheckBoxHighlight.Checked then
  362.   begin
  363.       adDrawGrid1.Highlight := clGray;
  364.     adDrawGrid1.HighlightText := clWhite;
  365.   end
  366.   else
  367.   begin
  368.       adDrawGrid1.Highlight := clHighlight;
  369.     adDrawGrid1.HighlightText := clHighlightText;
  370.   end;
  371. end;
  372.  
  373. procedure TFormMain.CheckBoxHighlightEnter(Sender: TObject);
  374. begin
  375.   ShowDemoText('demo1e');
  376. end;
  377.  
  378. procedure TFormMain.ComboBoxAlignmentChange(Sender: TObject);
  379. begin
  380.     adDrawGrid1.Columns[1].Alignment :=
  381.       TadCellAlignment(ComboBoxAlignment.ItemIndex);
  382. end;
  383.  
  384. procedure TFormMain.ComboBoxAlignmentEnter(Sender: TObject);
  385. begin
  386.   ShowDemoText('demo1f');
  387. end;
  388.  
  389. procedure TFormMain.TabDemoChange(Sender: TObject);
  390. begin
  391.     PanelProperty.Visible := (TabDemo.TabIndex = 0);
  392.     case TabDemo.TabIndex of
  393.   0 : ShowDemoText('demo1');
  394.   1 : ShowDemoText('demo2');
  395.   2 : ShowDemoText('demo3');
  396.   3 : ShowDemoText('demo4');
  397.   end;
  398. end;
  399.  
  400. procedure TFormMain.ShowDemoText(const Name: String);
  401. var
  402.     Stream : TResourceStream;
  403. begin
  404.     Stream := TResourceStream.Create(hInstance,Uppercase(Name),'RTFDATA');
  405.     try
  406.         RichEdit.Lines.LoadFromStream(Stream);
  407.     finally
  408.         Stream.Free;
  409.     end;
  410. end;
  411.  
  412. end.
  413.